perm filename PROFFT.SAI[AER,HPM] blob sn#202117 filedate 1976-02-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PROFFT"
C00006 ENDMK
C⊗;
BEGIN "PROFFT"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FFTHDR.SAI[NUM,HPM]" SOURCE_FILE;

   BEGIN
   INTEGER I,J,K,PSIZ,PXMAX;
   INTEGER HI,WI,MH,MW;
   STRING INFL;
   INTEGER ARRAY PIC,PIC1[0:PIXDIM(64,64,8)];
   REAL ARRAY A,B[0:64*64];
   REAL N,P,Q;

   DO OUTSTR("INPUT FILE:") UNTIL PFLDIM(INFL←INCHWL)>0;

      BEGIN
      INTEGER ARRAY T[0:PFLDIM(INFL)],T1[0:PIXDIM(256,256,4)];
      MAKPIX(256,256,4,T1[0]);
      GETPFL(INFL,T[0]); SHRINK(T[0],T1[0]);
      HAFPIC(T1[0],T[0],6);
      HAFPIC(T[0],PIC[0],8);
      END;

   MAKPIX(64,64,8,PIC1[0]);

   PSIZ←PIC[PCBY];

   HI←64; WI←64; PXMAX←2↑8-1; MW←MH←6;


   FOR I←0 STEP 1 UNTIL HI-1 DO
   FOR J←0 STEP 1 UNTIL WI-1 DO
      A[I*WI+J]←PIXEL(PIC[0],I,J);


   FOR I←0 STEP 1 UNTIL HI-1 DO
   FOR J←0 STEP 1 UNTIL WI-1 DO
      B[I*WI+J]←0;

comment  2d transform;

   N←2↑(MW+MH); P←Q←1/SQRT(N);

   FFT2(A,B,HI*WI,MW,WI); REORDER(A,B,HI*WI,MW,WI,FALSE);
   FFT2(A,B,HI*WI,MH,HI*WI); REORDER(A,B,HI*WI,MH,HI*WI,FALSE);


   FOR I←N-1 STEP -1 UNTIL 0 DO
      BEGIN
      A[I]←A[I]*P;  B[I]←B[I]*Q;
      END;

comment  inverse transform;

   N←2↑(MW+MH); P←Q←1/SQRT(N);

   FOR I←N-1 STEP -1 UNTIL 0 DO B[I]←-B[I];
   Q←-Q;

   FFT2(A,B,HI*WI,MW,WI); REORDER(A,B,HI*WI,MW,WI,FALSE);
   FFT2(A,B,HI*WI,MH,HI*WI); REORDER(A,B,HI*WI,MH,HI*WI,FALSE);

   FOR I←N-1 STEP -1 UNTIL 0 DO
      BEGIN
      A[I]←A[I]*P;  B[I]←B[I]*Q;
      END;


   FOR I←0 STEP 1 UNTIL HI-1 DO
   FOR J←0 STEP 1 UNTIL WI-1 DO
      PUTEL(PIC1[0],I,J,
                (A[I*WI+J] MAX 0) MIN PXMAX);

   DDINIT; SCREEN(-1,1.5,1,-.5); MAPMON(1);

   FOR I←1 STEP 1 UNTIL PIC[BYBI] DO
   IF SYNMAP(I-1)≠0 THEN
      BEGIN
      DRKEN; RECTAN(-2,-2,2,2);
      VIDEO(-1,1,0,0,PIC[0],1 ASH (PIC[BYBI]-I));
      VIDEO(0,1,1,0,PIC1[0],1 ASH (PIC[BYBI]-I));
      DPYUP(SYNMAP(I-1)); DPYUP(SYNMAP(I-1)); DPYUP(SYNMAP(I-1));
      SHOWA('47);
      END;

   END;
END;